home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 25 / CU Amiga Magazine's Super CD-ROM 25 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-08].iso / CUCD / Programming / BlitzList / BlitzListFiles / gasp.lha / GASP / GASP.bb2 next >
Encoding:
Text File  |  1998-05-11  |  7.3 KB  |  390 lines
  1.  
  2.           ;#########################
  3.           ;#         GASP          #
  4.           ;#   Genetic Algorithm   #
  5.           ;#     Sample Packer     #
  6.           ;#                       #
  7.           ;#  Copyright (C) 1998   #
  8.           ;#          by           #
  9.           ;# Christos Dimitrakakis #
  10.           ;#                       #
  11.           ;#########################
  12.  
  13. ;  This program is Free software; you can redistribute it and/or modify
  14. ;  it under the terms of version 2 of the GNU General Public License as
  15. ;  published by the Free Software Foundation.
  16. ;
  17. ;  This program is distributed in the hope that it will be useful,
  18. ;  but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;  MERCHANTABILITY OR FITNESS For A PARTICULAR PURPOSE.  See the
  20. ;  GNU General Public License For more details.
  21. ;
  22. ;  You should have received a copy of the GNU General Public License
  23. ;  along with this program; if not, write to the Free Software
  24. ;  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  25. ;
  26.  
  27.  
  28.  
  29.  
  30.  
  31. ;this program loads a sound called "GAMES:e1Thumb"
  32. ;change it to something else, or use ASL requester, or
  33. ;use argument reading..
  34.  
  35. ;then it saves the following files:
  36.  
  37. ;RAM:std_snd - the raw sound data
  38. ;RAM:cmp_snd - error data
  39. ;RAM:rec_snd - raw sound, recreated from the error data
  40.  
  41. ;after this, cmp_snd should be compressed using an external packer
  42. ;implementation of this program as an XPK sublib, utilizing SHRI for
  43. ;the final packing should produce the best results
  44. ;the error data creation is not optmized...
  45.  
  46. ;anyway, the program works by doing a linear prediction on the waveform
  47. ;and then saving the prediction error on a file
  48. ;if the prediction is perfect then all errors are 0 and you get
  49. ;100% compression, however, this is never the case :/
  50.  
  51. ;the linear predictor coefficients are initially set to
  52. ;2,-1,0,0,..,0
  53. ;which is the simple first order linear prediction
  54. ;a population of solutions is randomly created
  55. ;with the size of the population equaling pop_size
  56. ;into which a couple of simple linear prediction coefficient
  57. ;solutions are seeded during initialization
  58. ;All solutions are evaluated then crossed-over
  59. ;and mutated, then re-evaluated, etc.. for max_generations
  60. ;iterations of the algorithm
  61.  
  62. ;demes - if this is true then crossover can only take
  63. ;place in a linear neighbourhood of size neigh
  64.  
  65. ;tour_size - how many individuals to consider, when
  66. ; a solution is choosing a mate. Large tour_size
  67. ; means that better solutions are selected. If it
  68. ; is too large then premature convergence may occur.
  69. ; this depends on population and neighbourhood size
  70.  
  71.  
  72.  
  73.  
  74.  
  75. break.b=False
  76. dbreak.b=False
  77.  
  78.  
  79. LoadSound 0,"games:e1thumb" ;change this to something else..
  80.  
  81.  
  82. DEFTYPE .sound *mysound
  83. *mysound=Addr Sound(0)
  84. InitBank 0,*mysound\_length*2,65536
  85. InitBank 1,*mysound\_length*2,65536
  86. src.l=Bank(0)
  87. dst.l=Bank(1)
  88.  
  89. lngth.l=*mysound\_length*2
  90.  
  91. LOSS.b=0
  92. nofcos=8
  93.  
  94. NEWTYPE .coef
  95.   coef.q[16]
  96. End NEWTYPE
  97.  
  98. pop_size=4000
  99. max_generations=100
  100. demes.b=True
  101. neigh.w=200
  102. tour_size=10
  103. Dim ind.coef(pop_size)
  104. Dim fit.l(pop_size)
  105. Dim y.q(nofcos)
  106. Dim a.q(nofcos)
  107.  
  108.  
  109. Statement copysound{snd.w,dst.l,ln.l}
  110.   For n.l=0 To ln-1
  111.     Poke.b dst,PeekSound(snd,n)
  112.     dst+1
  113.   Next n
  114.   NPrint n
  115. End Statement
  116.  
  117. Statement filt{src.l,dst.l,ln.l}
  118.   y.q=0
  119.   For n.l=0 To ln-1
  120.     y1=y0
  121.     y0=Peek.b (src)
  122.     y=(y0+y1)/2
  123.     Poke.b dst,y
  124.     src+1
  125.     dst+1
  126.   Next n
  127. End Statement
  128.  
  129. Function.l write_errors{src.l,dst.l,ln.l,coeff.l}
  130.   SHARED LOSS,nofcos,y(),a()
  131.   DEFTYPE .coef *mycos
  132.   *mycos=coeff
  133.   For f.w=1 To nofcos
  134.     a(f)=*mycos\coef[f]
  135.     y(f)=0
  136.   Next f
  137.   y.q=0
  138.   est.l=0
  139.   error.q=0
  140.  
  141.   db.b=0
  142.  
  143.   For n.l=0 To ln-1
  144.  
  145.     y0=0
  146.     For f.w=1 To nofcos
  147.       y0+a(f)*y(f)
  148.     Next f
  149.     y0=Int(QLimit(y0,-128,127))
  150.  
  151.     y=Peek.b(src)
  152.  
  153.     For f=nofcos To 2 Step -1
  154.       y(f)=y(f-1)
  155.     Next f
  156.     y(1)=y
  157.  
  158.     If db=0
  159.       error=(y-y0) ASR LOSS
  160.     Else
  161.       error=0
  162.     EndIf
  163.     ;db=1-db
  164.  
  165.     Poke.b dst,error
  166.     est+QAbs(error)
  167.  
  168.     src+1
  169.     dst+1
  170.   Next n
  171.   Function Return est
  172. End Function
  173.  
  174. Statement reconstruct{src.l,dst.l,ln.l,coeff.l}
  175.   SHARED LOSS,nofcos,y(),a()
  176.   DEFTYPE .coef *mycos
  177.   *mycos=coeff
  178.   For f.w=1 To nofcos
  179.     a(f)=*mycos\coef[f]
  180.     y(f)=0
  181.   Next f
  182.   y.b=0
  183.   est.l=0
  184.   error.b=0
  185.  
  186.   For n.l=0 To ln-1
  187.  
  188.     y0=0
  189.     For f.w=1 To nofcos
  190.       y0+a(f)*y(f)
  191.     Next f
  192.     y0=Int(QLimit(y0,-128,127))
  193.  
  194.  
  195.     error=Peek.b(src)
  196.  
  197.     y=y0+(error ASL LOSS)
  198.  
  199.     For f=nofcos To 2 Step -1
  200.       y(f)=y(f-1)
  201.     Next f
  202.     y(1)=y
  203.  
  204.     Poke.b dst,y
  205.  
  206.     src+1
  207.     dst+1
  208.   Next n
  209. End Statement
  210.  
  211. Statement save_raw{pos.l,ln.l,f$}
  212.   If Exists(f$)
  213.     KillFile f$
  214.   EndIf
  215.   If WriteFile(0,f$)
  216.     FileOutput 0
  217.     For n.l=0 To ln-1
  218.       byte.b=Peek.b(pos)
  219.       Print Chr$(byte)
  220.       pos+1
  221.     Next n
  222.     DefaultOutput
  223.     CloseFile 0
  224.   EndIf
  225.   NPrint ln
  226. End Statement
  227.  
  228.  
  229. Statement showind{l.l}
  230.   SHARED nofcos
  231.   DEFTYPE .coef *ind
  232.   *ind=l
  233.   For f.w=1 To nofcos
  234.     NPrint *ind\coef[f]
  235.   Next f
  236. End Statement
  237.  
  238.  
  239. .main
  240. copysound{0,src,lngth}
  241. save_raw{src,lngth,"RAM:std_snd"}
  242. filt{src,src,lngth}
  243.  
  244.  
  245. Gosub initpop
  246. bst.l=-1
  247.  
  248. gen.w=1
  249. Repeat
  250.   NPrint "Generation ",gen
  251.   NPrint "Evaluation"
  252.   Gosub evalpop
  253.   NPrint "BST:",bst
  254.   showind{&ind(0)}
  255.   NPrint "Crossover"
  256.   Gosub crosspop
  257.   gen+1
  258. Until (gen>max_generations) OR (break=True) OR (dbreak=True)
  259.  
  260.  
  261. Gosub evalpop
  262.  
  263. If dbreak=False
  264.   dummy.l=write_errors{src,dst,lngth,&ind(0)}
  265.   save_raw{dst,lngth,"RAM:cmp_snd"}
  266.   reconstruct{dst,src,lngth,&ind(0)}
  267.   save_raw{src,lngth,"RAM:rec_snd"}
  268. EndIf
  269.  
  270.  
  271.  
  272. End
  273.  
  274.  
  275. .initpop
  276.   NPrint "Initializing population"
  277.   For n=1 To pop_size
  278.     For f.w=1 To nofcos
  279.       ind(n)\coef[f]=(Rnd-.5)*32
  280.     Next f
  281.   Next n
  282.  
  283. CNIF 1=1
  284.   For n=1 To 2
  285.     j.w=Int(Rnd(pop_size))+1
  286.     ind(j)\coef[1]=2
  287.     ind(j)\coef[2]=-1
  288.     For f=3 To nofcos
  289.       ind(j)\coef[f]=0
  290.     Next f
  291. ;    showind{&ind(j)}
  292.   Next n
  293. CEND
  294. Return
  295.  
  296.  
  297.  
  298. .evalpop
  299.   percount1=10/pop_size
  300.   percount2=0
  301.   percount=0
  302.   j.w=1
  303.   Repeat
  304.     fit(j)=0
  305.     For trials.w=1 To 1
  306. ;      strt.l=Int(Rnd(lngth-128))
  307.       strt.l=0
  308.       fit(j)+write_errors{src+strt,dst,256,&ind(j)}
  309.     Next trials
  310.  
  311.     If bst=-1
  312.       bst=fit(j)
  313.     Else
  314.       If bst>fit(j)
  315.         bst=fit(j)
  316.         For f.w=1 To nofcos
  317.           ind(0)\coef[f]=ind(j)\coef[f]
  318.         Next f
  319.       EndIf
  320.     EndIf
  321.     percount2+percount1
  322.     If percount2>=1
  323.       percount2-1
  324.       percount+1
  325.       NPrint percount,"0% done"
  326.     EndIf
  327.     Gosub break_test
  328.     j+1
  329.   Until (j>pop_size) OR (break=True) OR (dbreak=True)
  330. Return
  331.  
  332. .crosspop
  333.   j.w=1
  334.   neigh2=neigh/2
  335.   Repeat
  336.     winner.w=-1
  337.     For tour.w=1 To tour_size
  338.     If demes=False
  339.       cr.w=Int(Rnd*pop_size)+1
  340.     Else
  341.       cr.w=QLimit(j+(Int(Rnd*(neigh+1))-neigh2),1,pop_size)
  342.     EndIf
  343.       If winner=-1
  344.         winner=cr
  345.       Else
  346.         If fit(cr)<fit(winner)
  347.           winner=cr
  348.         EndIf
  349.       EndIf
  350.     Next tour
  351.     For f.w=1 To nofcos
  352.       perc=Rnd(4)-2
  353.       ind(j)\coef[f]=.5*((1+perc)*ind(j)\coef[f]-(1-perc)*ind(winner)\coef[f])
  354.     Next f
  355.     Gosub break_test
  356.     j+1
  357.   Until (j>pop_size) OR (break=True) OR (dbreak=True)
  358. Return
  359.  
  360.  
  361. .mutate
  362.   For n=1 To 10
  363.     mut.w=Int(Rnd*pop_size)+1
  364.     For f=1 To nofcos
  365.       If Rnd>.5
  366.         ind(n)\coef[f]=Rnd(65536)-32768
  367.       EndIf
  368.     Next f
  369.   Next n
  370. Return
  371.  
  372. .break_test
  373.   If (SetSignal_(0,#SIGBREAKF_CTRL_C)AND #SIGBREAKF_CTRL_C)
  374.     break=True
  375.     NPrint ""
  376.     NPrint "interrupted"
  377.     NPrint "==========="
  378.   EndIf
  379.  
  380. break_test2:
  381.   If (SetSignal_(0,#SIGBREAKF_CTRL_D)AND #SIGBREAKF_CTRL_D)
  382.     dbreak=True
  383.     NPrint ""
  384.     NPrint "***BREAK***"
  385.     NPrint ""
  386.   EndIf
  387. Return
  388.  
  389.  
  390.